home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / elflib.zip / NOTEPAD.LSP < prev    next >
Text File  |  1992-12-01  |  15KB  |  392 lines
  1. ;;; NOTEPAD.LSP
  2. ;;; Copyright 1992 by Mountain Software
  3. ;;;
  4. ;;; This program requires ELF, the Extended List Function library
  5. ;;;
  6. ;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
  7. ;;; WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
  8. ;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
  9. ;;;
  10. ;;;*===================================================================*
  11. ;;;
  12. ;;; The ELF Notepad is a demonstration of the powerful capabilities
  13. ;;; of the ELF library in a "real" application. Notepad works well
  14. ;;; in editing small to medium text files. It is not a full featured
  15. ;;; editor, but is fully programmable by any AutoLISP programmer.
  16. ;;; In fact Notepad can be used to modify itself, so try your hand
  17. ;;; at creating your own custom editor.
  18.  
  19. (Princ "\nLoading Notepad.Lsp...")
  20. (Load"ELF")                             ;load ELF.EXP, color and key symbols
  21.  
  22. ;*----- This Function merely executes Notepad using specifed colors and size
  23.  
  24. (DeFun C:NP()
  25.   (Notepad 80 25 (| lgrey blue_bg) (| yellow blue_bg))
  26. )
  27.  
  28. (DeFun C:NOTEPAD() (C:NP))             ;;; an alias
  29.  
  30. ;*----- The Main Notepad Function
  31.  
  32. (DeFun NOTEPAD (cols rows color hcolor /
  33.                i str txt done wrows lasti repaint lastwrow typ tmpval tmpstr
  34.                rslt key wcol wrow col edit_help)
  35.  
  36.   ;*----- The following functions a local to NOTEPAD
  37.  
  38.   (DeFun title(np_filename)
  39.     (Wtitle (Strnset "═" cols) 1 (| lgrey blue_bg))
  40.     (Wtitle (If np_filename np_filename "[ ELF Notepad ]") 1 (| white red_bg))
  41.   )
  42.   (DeFun repaint() (paint wrows i color)(SetQ wrow 0) (gc))
  43.   (DeFun reset() (SetQ np_data '("") i 0 wrow 0 wcol 0 lasti 0 changed nil np_filename nil)
  44.                  (title np_filename) (repaint))
  45.  
  46.   (SetQ olderr *error* *error* NPerror)
  47.   (Wpopup cols rows color color double_bd)
  48.   (Wtitle "[F1] Help  [F2] Search  [F3] New  [F4] Load  [F10] Save  [Esc] Exit"
  49.           4 (| dgrey lgrey_bg))
  50.   (title np_filename)
  51.   (SetQ i 0 wrow 0 wcol 0 col (Car (Winfo)) done nil
  52.         lasti (Max (1-(Length np_data)) 0)
  53.         wrows (- rows 2) lastwrow (1- wrows))
  54.  
  55.   ;*----- User Defined help for Notepad
  56.  
  57.   (Set_Edit_Help
  58.         '("ELF Notepad Help" "" "F2\t\tString search\t\t[PgDn - More]"
  59.           "F3\t\tOpen a new file" "F4\t\tLoad a file"
  60.           "F10\t\tSave file" "Ctrl-Home\tMove to top of file"
  61.           "Ctrl-End\tMove to bottom of file"
  62.           "PgUp\tmove up one full page" "PgDn\tmove down one full page"
  63.           "Enter\tSplit line" "Ctrl-Bkspc\tJoin line"
  64.           "Esc\t\tClose Notepad window" ""
  65.           "Notepad is an ELFapp (tm), ELF (c) Mountain Software"
  66.           "" ""
  67.           "Grey Plus\t\tCopy Line"
  68.           "Grey Minus\t\tCut Line"
  69.           "Grey Asterisk\tPaste Line"
  70.           "Ctrl-F1\t\tAutoLISP evaluate line"
  71.           "Ctrl-F10\t\tSave and load AutoLISP file" ""
  72.           "The Notepad text is stored in the global AutoLISP symbol"
  73.           "\"NP_DATA\" as a list if strings."
  74.           "" "" "Press <F1> for additional help" "" "" "" "" ""))
  75.  
  76.   (If(Not(Car np_data)) (Progn
  77.     (SetQ np_data '("") np_filename nil)
  78.     (Wmenu '("Welcome to the ELF Notepad" ""
  79.              "Notepad is a demonstration of the string and"
  80.              "list handling functions of ELF and demonstrates"
  81.              "both the power and weaknesses of AutoLISP for"
  82.              "a \"real\" application." ""
  83.              "Notepad works fine for small to medium text"
  84.              "files, large files will slow it to a crawl."
  85.              "You can customize Notepad to your own liking"
  86.              "using Notepad itself!" ""
  87.              "Press <Esc> to enter Notepad...")
  88.              -1 -1 48 63 48 (| 5 32))))
  89.   (repaint)
  90.  
  91.   ;*----- This is the primary program loop
  92.  
  93.   (While (Not done) (Progn
  94.     (Wtitle (Sprintf "Row: %-3d" (1+ i)) 2)
  95.     (WgotoXY 0 wrow)
  96.     (SetQ prevwrow wrow
  97.           txt (Nth i np_data)
  98.           ;*----- StrGet is the "Workhorse" function for Notepad. The
  99.           ;       keycodes within the function call will cause StrGet
  100.           ;       to terminate. The returned value can then be tested with
  101.           ;       "Cond" to determine the key pressed to exit StrGet
  102.           rslt    (StrGet txt (- cols 2) (1-(+ wcol col)) " " hcolor F2_Key
  103.                      F3_Key F4_Key F10_Key PgUp_Key PgDn_Key G_Pls_Key
  104.                      G_Min_Key G_Ast_Key C_Home_Key C_F1_Key C_BS_Key
  105.                      C_F10_Key C_End_Key)
  106.           str    (Car rslt)
  107.           key    (Cadr rslt)
  108.           scol   (Caddr rslt)
  109.           wcol   (1+ (- scol col)))
  110.     (Wprts 0 wrow str color)
  111.     ;*----- Update primary buffer.
  112.     (If(/= str txt)
  113.       (SetQ np_data (Replace np_data i str) changed T))
  114.     (Cond
  115.       ;*----- quit
  116.       ((= key Esc_Key)    (SetQ done T))
  117.       ;*----- search
  118.       ((= key F2_Key)     (search 'i lasti) (repaint))
  119.       ;*----- clear buffer and screen
  120.       ((= key F3_Key)     (If(ok_to_close) (reset)))
  121.       ;*----- load a new file
  122.       ((= key F4_Key)     (If(ok_to_close)(Progn
  123.                           (reset)
  124.                           (Load_file)
  125.                           (title np_filename)
  126.                           (SetQ i 0 wrow 0 wcol 0
  127.                                 lasti (1-(Length np_data))
  128.                                 changed nil)
  129.                           (repaint))))
  130.       ;*----- copy current line to cut buffer
  131.       ((= key G_Pls_Key)  (SetQ tmpstr str)(beep 700 0.1))
  132.       ;*----- cut current line to cut buffer
  133.       ((= key G_Min_Key)  (SetQ tmpstr str changed T
  134.                                 np_data  (If(> lasti 0) (Delete np_data i) '("")))
  135.                           (If(= i lasti)
  136.                             (SetQ i     (Max (1- i) 0)
  137.                                   wrow  (Max (1- wrow) 0)))
  138.                           (SetQ lasti (Max (1- lasti) 0))
  139.                           (paint wrows (- i wrow) color))
  140.       ;*----- paste cut buffer to cursor
  141.       ((= key G_Ast_Key)  (SetQ np_data (Insert np_data i tmpstr)
  142.                                 lasti (1+ lasti) changed T)
  143.                           (paint wrows (- i wrow) color))
  144.       ;*----- save the file
  145.       ((= key F10_Key)    (save_file)(title np_filename))
  146.       ;*----- save the file and load as an AutoLISP file
  147.       ((= key C_F10_Key)  (save_file)   (title np_filename)
  148.                           (Save_Screen) (CLS 7)
  149.                           (If(Load np_filename)
  150.                             (Wmsg (Strcat np_filename "\nloaded successfully"))
  151.                             (Wmsg (Strcat np_filename "\nfailed to load"))
  152.                           )
  153.                           (Restore_Screen))
  154.       ;*----- Have AutoLISP evaluate the current line, this can produce some
  155.       ;*----- useful, strange and disasterous results, use at your own risk!
  156.       ;*----- The return value is placed in the cut buffer and can be pasted
  157.       ;*----- to the screen with the paste [Grey Asterick] key.
  158.       ((= key C_F1_Key)     (Save_Screen)
  159.                             (SetQ tmpval (Eval(Read str))
  160.                                 typ    (type tmpval)
  161.                                 tmpstr (Cond
  162.                             ((null tmpval) "nil")
  163.                             ((= typ 'INT) (itoa tmpval))
  164.                             ((= typ 'STR) tmpval)
  165.                             ((= typ 'REAL) (rtos tmpval 2))
  166.                             ((= typ 'SUBR) "AutoLISP Internal Function")
  167.                             ((= typ 'EXSUBR) "External Function")
  168.                             ((= typ 'LIST) "List or Function")
  169.                             (T "Unsupported Type")))
  170.                           (Restore_Screen)
  171.                           (Wmsg (StrCat str "\nEvaluates To:\n" tmpstr)))
  172.       ;*----- Move to first line
  173.       ((= key C_Home_Key) (If(> i 0)(Progn(SetQ i 0 wcol 0 wrow 0) (repaint))))
  174.       ;*----- Move to last line
  175.       ((= key C_End_Key)  (If(< i lasti) (Progn
  176.                           (SetQ i (Max(1+(- lasti wrows)) 0) wcol 0 wrow 0)
  177.                           (repaint)
  178.                           (SetQ i lasti wrow (Min (1- wrows) i)))))
  179.       ;*----- Move up one line
  180.       ((= key Up_Key)     (moveup 'wrow 'i 1))
  181.       ;*----- Move up one page
  182.       ((= key PgUp_Key)   (If(> i 0)(Progn(moveup 'wrow 'i wrows)(repaint))))
  183.       ;*----- Move down one page
  184.       ((= key PgDn_Key)   (If(< i lasti) (Progn
  185.                             (movedn 'wrow 'i wrows lasti lastwrow)(repaint))))
  186.       ;*----- Split line at cursor
  187.       ((= key C_BS_Key)   (If(> i 0) (Progn
  188.                             (SetQ i (1- i)
  189.                                   np_data  (Delete (Replace np_data i
  190.                                           (StrCat (Nth i np_data) str)) (1+ i))
  191.                                   wrow  (1- wrow)
  192.                                   lasti (1- lasti)
  193.                                   changed T)
  194.                             (paint wrows (- i wrow) color)
  195.                           )))
  196.       ;*----- insert / split line
  197.       ((= key Enter_Key)  (SetQ np_data (Replace np_data i (SubStr str 1 scol))
  198.                              tmp (SubStr str (1+ scol) 255)
  199.                              changed T)
  200.                           (If(/= i lasti)
  201.                             (SetQ np_data (Insert np_data (1+ i) tmp))
  202.                             (SetQ np_data (Append np_data (List tmp))))
  203.                           (SetQ lasti (1+ lasti) wcol 0)
  204.                           (movedn 'wrow 'i 1 lasti lastwrow)
  205.                           (paint wrows (- i wrow) color))
  206.       ;*----- move the cursor down 1 line scrolling if necessary
  207.       (T                  (movedn 'wrow 'i 1 lasti lastwrow))
  208.     )
  209.   ))
  210.   (Wclose)
  211.   (SetQ *error* olderr olderr nil)
  212.   (Cls 7)
  213. )
  214.  
  215. ;*----- Error Routine
  216.  
  217. (DeFun NPERROR(s)
  218.   (Beep)
  219.   (Wmsg (Sprintf "Notepad ERROR\n%s" s) 1 (| white red_bg))
  220.   (WcloseAll)
  221.   (Cls 7)
  222.   (SetQ *error* olderr olderr nil)
  223.   (Princ)
  224. )
  225.  
  226. ;*----- Check for modified buffer
  227.  
  228. (DeFun OK_TO_CLOSE( / ans file fl fname)
  229.   (SetQ fl (SplitPath np_filename)
  230.         fname (MakePath "" "" (Caddr fl) (Cadddr fl))
  231.         file (If np_filename fname "UnNamed File"))
  232.   (If changed
  233.     (wgetyn (Sprintf "Discard changes to \"%s\" ?" file))
  234.     T
  235.   )
  236. )
  237.  
  238. ;*----- Get a yes or no response
  239.  
  240. (DeFun WGETYN(msg / yn ans col)
  241.   (SetQ yn '("No" "Yes") col (| black cyan_bg))
  242.   (WpopUp (+(strlen msg) 2) 6 col col (| no_brd shadow_bd))
  243.   (Wtitle msg)
  244.   (setq ans (Wmenu yn -1 -1 col col (| white black_bg) (| single_bd tlhl_bd)))
  245.   (setq ans
  246.     (cond
  247.       ((= (cadr ans) Esc_Key) nil)
  248.       ((= (car ans) 1) T)
  249.       (T nil)
  250.     )
  251.   )
  252.   (Wclose)
  253.   ans
  254. )
  255.  
  256. ;*----- Scroll the window up
  257.  
  258. (DeFun MOVEUP(&row &i rows / _row _idx)
  259.   (SetQ _row  (- (Eval &row) rows)
  260.         _idx  (- (Eval &i) rows))
  261.   (If (< _row 0) (Progn
  262.     (SetQ _row 0)
  263.     (If (>= _idx 0)
  264.       (If(= rows 1) (Wscroll 1))
  265.       (SetQ _idx 0))
  266.   );else
  267.     (If (< _idx 0)
  268.       (SetQ _idx 0 _row 0))
  269.   )
  270.   (Set &row _row) (Set &i _idx)
  271. )
  272.  
  273. ;*----- Scroll the window down
  274.  
  275. (DeFun MOVEDN(&row &i rows lasti lastwrow / _row _idx)
  276.   (SetQ _row (+ (Eval &row) rows)
  277.         _idx (+ (Eval &i) rows))
  278.   (If (> _row lastwrow) (Progn
  279.     (SetQ _row lastwrow)
  280.     (If (<= _idx lasti)
  281.       (If(= rows 1) (Wscroll 0))
  282.       (SetQ _idx lasti))
  283.   );else
  284.     (If (> _idx lasti)
  285.       (SetQ _idx lasti _row (Eval &row)))
  286.   )
  287.   (Set &row _row) (Set &i _idx)
  288. )
  289.  
  290. ;*----- Display a screen of text
  291.  
  292. (DeFun PAINT(wrows i color / row)
  293.   (Wcls)
  294.   (SetQ row 0)
  295.   (Repeat wrows
  296.     (Wprts 0 row (Nth i np_data) color)
  297.     (SetQ i (1+ i) row (1+ row))
  298.   )
  299. )
  300.  
  301. ;*----- Load a file
  302.  
  303. (DeFun LOAD_FILE( / col)
  304.   (SetQ col (| white red_bg))
  305.   (If (GetFilename)
  306.      (if(file_exists np_filename) (progn
  307.        (Wmsg (Sprintf "Loading %s..." np_filename) nil col)
  308.        (SetQ np_data (Read_File np_filename))
  309.        (Wclose)
  310.      );else
  311.      (progn
  312.        (Wmsg "New File" 1 col)
  313.        (setq np_filename (FullPath (StrCase np_filename)))
  314.      ))
  315.   )
  316.   (If(Not np_data) (SetQ np_data '("") np_filename nil))
  317. )
  318.  
  319. ;*----- Prompt for a filename
  320.  
  321. (DeFun GETFILENAME( / stdat file temp fin)
  322.    (SetQ  file  (If np_filename np_filename ""))
  323.    (WpopUp 42 3 (| yellow black_bg))
  324.    (Wtitle "Enter Filename" 0)
  325.    (Wtitle "[ F2 - Directory ]" 3)
  326.    (While(not fin) (progn
  327.      (Wgotoxy 0 0)
  328.      (SetQ stdat (Strget file 40 0 " " (| white black_bg) F2_Key)
  329.            file    (car stdat)
  330.            key    (cadr stdat))
  331.      (cond
  332.        ((Or(= key F2_Key)(And(= file "")(= key Enter_Key)))
  333.          (If(Setq temp (WgetFile file 33 -1 -1 (| white cyan_bg)))
  334.             (Setq file temp)))
  335.        ((= key Esc_Key) (Setq fin t))
  336.        (T (SetQ np_filename (If(Not(= file "")) (FullPath file) nil) fin T))
  337.      )
  338.    ))
  339.    (Wclose)
  340.    (If (= key Esc_Key) nil np_filename)
  341. )
  342.  
  343. ;*----- Save the list buffer to a file
  344.  
  345. (DeFun SAVE_FILE( / fl bakfn)
  346.   (If (GetFileName) (Progn
  347.     (SetQ changed nil)
  348.     (Wmsg (Sprintf "Saving %s..." np_filename) nil (| white red_bg))
  349.     (SetQ fl (SplitPath np_filename)
  350.           bakfn (MakePath (car fl) (cadr fl) (caddr fl) ".BAK"))
  351.     (If(file_exists file) (progn
  352.       (EraseFile bakfn)
  353.       (MoveFile np_filename bakfn)
  354.     ))
  355.     (If(Not(Write_File np_filename "" np_data))
  356.       (Wmsg (Sprintf "Error Writing file \"%s\"" np_filename)))
  357.     (Wclose)
  358.   ))
  359. )
  360.  
  361. ;*----- Search from current line for a string
  362.  
  363. (DeFun SEARCH(&i lastline / lin fin found dat col)
  364.   (If(Not srch_str) (SetQ srch_str ""))
  365.   (SetQ lin (Eval &i) fin nil found nil col (| white red_bg)
  366.         srch_str (StrCase(WgetStr "Search String" srch_str 40 col)))
  367.   (If (>(StrLen srch_str) 0) (Progn
  368.     (Wmsg (Sprintf "Searching for %s..." srch_str) nil col)
  369.     (If(>= lin lastline) (SetQ fin t))
  370.     (While (Not fin) (Progn
  371.       (SetQ lin (1+ lin))
  372.       (SetQ dat (StrCase (Nth lin np_data)))
  373.       (If(>(StrLen dat) 0)
  374.         (If(StrStr dat srch_str) (Progn
  375.           (SetQ fin t found t)
  376.           (Set &i lin)
  377.         ))
  378.       )
  379.       (If(>= lin lastline) (SetQ fin t))
  380.     ))
  381.     (Wclose)
  382.     (If (Not found)
  383.       (Wmsg (Sprintf "\"%s\" Not Found" srch_str) 1 col))
  384.   ))
  385. )
  386.  
  387. (Princ "\nNotePad.Lsp loaded, enter \"NP\" or \"NotePad\" to run...")
  388. (Princ)
  389.  
  390. ;;;*----- End of Notepad.Lsp
  391.  
  392.